home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / packages / recent-files.el.z / recent-files.el
Encoding:
Text File  |  1998-05-21  |  26.7 KB  |  722 lines
  1. ;;; recent-files.el --- Maintain menu of recently opened files.
  2. ;;; $Header: recent-files.el[1.9] Wed Jan 18 21:42:36 1995 nickel@prz.tu-berlin.de saved $
  3. ;;;
  4. ;;; Copyright (C) 1994, 1995 Juergen Nickelsen <nickel@cs.tu-berlin.de>
  5. ;;;
  6. ;; Keywords: menu, file
  7.  
  8. ;; This file is part of XEmacs.
  9.  
  10. ;; XEmacs is free software; you can redistribute it and/or modify it
  11. ;; under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; XEmacs is distributed in the hope that it will be useful, but
  16. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18. ;; General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with XEmacs; see the file COPYING.  If not, write to the 
  22. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23. ;; Boston, MA 02111-1307, USA.
  24.  
  25. ;;; Synched up with: Not in FSF.
  26. ;;;
  27. ;;; recent-files.el is free software; you can redistribute it and/or
  28. ;;; modify it under the terms of the GNU General Public License as
  29. ;;; published by the Free Software Foundation; either version 2, or
  30. ;;; (at your option) any later version.
  31. ;;;
  32. ;;; It is distributed in the hope that it will be useful, but WITHOUT
  33. ;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  34. ;;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  35. ;;; License for more details.
  36. ;;;
  37. ;;; You should have received a copy of the GNU General Public License
  38. ;;; along with XEmacs; see the file COPYING.  If not, write to the
  39. ;;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  40. ;;; ------------------------------------------------------------------
  41. ;;;
  42. ;;; Enough of this boring stuff. To install recent-files, put the
  43. ;;; following statements into your .emacs file 
  44. ;;;    (load "recent-files")
  45. ;;;    (recent-files-initialize)
  46. ;;; and place the file recent-files.el in a directory in your XEmacs's
  47. ;;; load-path.  In order to use recent-files with dired, dired has to
  48. ;;; be loaded first.  recent-files is known to work with Lucid Emacs /
  49. ;;; XEmacs 19.8 and higher; it does not work correctly with 19.6 or
  50. ;;; earlier versions due to a bug in add-menu.
  51. ;;;
  52. ;;; recent-files adds the menu "Recent Files" (or whatever name you
  53. ;;; choose, see "Customization:" below) to Emacs's menubar. Its
  54. ;;; entries are the files (and directories) that have recently been
  55. ;;; opened by Emacs. You can open one of these files again by
  56. ;;; selecting its entry in the "Recent Files" menu. The list of file
  57. ;;; entries in this menu is preserved from one Emacs session to
  58. ;;; another. You can prevent Emacs from saving this list by selecting
  59. ;;; "Don't save recent-files list on exit" from the menu. If you have
  60. ;;; disabled saving, you can re-enable it by selecting "Save
  61. ;;; recent-files list on exit".
  62. ;;;
  63. ;;; The menu has permanent and non-permanent entries. Permanent
  64. ;;; entries are marked with an asterisk in front of the filename. The
  65. ;;; non-permanent entries are hidden in a submenu.
  66. ;;;
  67. ;;; Each time you open a file in Emacs, it is added as a non-permanent
  68. ;;; entry to the menu. The value of `recent-files-number-of-entries'
  69. ;;; determines how many non-permanent entries are held in the
  70. ;;; menu. When the number of non-permanent entries reaches this value,
  71. ;;; the least recently added non-permanent entry is removed from the
  72. ;;; menu when another non-permanent entry is added. It is not removed
  73. ;;; from the list, though; it may reappear when entries are deleted
  74. ;;; from the list. The number of entries saved to disk is the value of
  75. ;;; the variable `recent-files-number-of-saved-entries'.
  76. ;;;
  77. ;;; Permanent entries are not removed from the menu. You can make a
  78. ;;; file entry permanent by selecting "Make <buffer> permanent" (where
  79. ;;; <buffer> is the name of the current buffer) when the current
  80. ;;; buffer holds this file. "Make <buffer> non-permanent" makes the
  81. ;;; file entry of the current buffer non-permanent.
  82. ;;;
  83. ;;; The command "Kill buffer <buffer> and delete entry" is handy when
  84. ;;; you have accidently opened a file but want to keep neither the
  85. ;;; buffer nor the entry.
  86. ;;;
  87. ;;; You can erase the list of non-permanent entries by selecting
  88. ;;; "Erase non-permanent entries" from the menu.
  89. ;;;
  90. ;;; Customization:
  91. ;;;
  92. ;;; There are lots of variables to control the behaviour of
  93. ;;; recent-files. You do not have to change any of them if you like it
  94. ;;; as it comes out of the box. However, you may want to look at these
  95. ;;; options to make it behave different.
  96. ;;;
  97. ;;; `recent-files-number-of-entries'
  98. ;;;    Controls how many non-permanent entries are shown in the
  99. ;;;    recent-files list.  The default is 15. 
  100. ;;;
  101. ;;; `recent-files-number-of-saved-entries'
  102. ;;;    Controls how many non-permanent entries are saved to disk when
  103. ;;;    Emacs exits or recent-files-save-the-list is called. The
  104. ;;;    default is 50.
  105. ;;;
  106. ;;; `recent-files-save-file'
  107. ;;;    The name of the file where the recent-files list is saved
  108. ;;;    between Emacs session. You probably don't need to change this.
  109. ;;;    The default is ".recent-files.el" in your home directory.
  110. ;;;
  111. ;;; `recent-files-dont-include'
  112. ;;;    A list of regular expressions for files that should not be
  113. ;;;    included into the recent-files list. This list is empty by
  114. ;;;    default. For instance, a list to exclude all .newsrc
  115. ;;;    files, all auto-save-files, and all files in the /tmp
  116. ;;;    directory (but not the /tmp directory itself) would look
  117. ;;;    like this:
  118. ;;;         (setq recent-files-dont-include
  119. ;;;               '("/\\.newsrc" "~$" "^/tmp/."))
  120. ;;;    The default is empty.
  121. ;;;
  122. ;;; `recent-files-use-full-names'
  123. ;;;    If the value of this variable is non-nil, the full pathnames of
  124. ;;;    the files are shown in the recent-files menu. Otherwise only
  125. ;;;    the filename part (or the last name component if it is a
  126. ;;;    directory) is shown in the menu. The default it t, i.e. show
  127. ;;;    full names.
  128. ;;;
  129. ;;; `recent-files-filename-replacements'
  130. ;;;    This is a list of pairs of regular expressions and replacement
  131. ;;;    strings. If a filename matches one of the regular expressions,
  132. ;;;    the matching part is replaced by the replacement string for
  133. ;;;    display in the recent-files menu.
  134. ;;;    Example: My home directory is "/users/mmc/nickel/". I want to
  135. ;;;    replace it with "~/". I also want to replace the directory
  136. ;;;    "/imports/teleservices/mmc/avc2/", where I work a lot, with
  137. ;;;    ".../avc2/". The list then looks like
  138. ;;;        (setq recent-files-filename-replacements
  139. ;;;              '(("/users/mmc/nickel/" . "~/")
  140. ;;;                ("/imports/teleservices/mmc/avc2/" . ".../avc2/")))
  141. ;;;    Only the first match is replaced. So, if you have several
  142. ;;;    entries in this list that may match a filename simultaneously,
  143. ;;;    put the one you want to match (usually the most special) in
  144. ;;;    front of the others. The default is to replace the home
  145. ;;;    directory with "~".
  146. ;;;
  147. ;;; `recent-files-sort-function'
  148. ;;;    Contains a function symbol to sort the display of filenames in
  149. ;;;    the recent-files menu. Supplied are two functions,
  150. ;;;    'recent-files-dont-sort and 'recent-files-sort-alphabetically.
  151. ;;;    The first, which is the default, preserves the order of "most
  152. ;;;    recent on top". 
  153. ;;;
  154. ;;; `recent-files-permanent-submenu'
  155. ;;;    If this variable is non-nil, the permanent entries are put into
  156. ;;;    a separate submenu of the recent-files menu. The default is
  157. ;;;    nil.
  158. ;;;
  159. ;;; `recent-files-non-permanent-submenu'
  160. ;;;    If this variable is non-nil, the non-permanent entries are put
  161. ;;;    into a separate submenu of the recent-files menu. The default
  162. ;;;    is nil. (You can set both `recent-files-permanent-submenu' and
  163. ;;;    `recent-files-non-permanent-submenu' to t to have both lists in
  164. ;;;    separate submenus.)
  165. ;;;
  166. ;;; `recent-files-commands-submenu'
  167. ;;;    If this variable is non-nil, the commands if recent-files are
  168. ;;;    placed in a submenu of the recent-files menu. The default is
  169. ;;;    nil.
  170. ;;;
  171. ;;; `recent-files-commands-submenu-title'
  172. ;;;    If the commands are placed in a submenu, this string is used as
  173. ;;;    the title of the submenu. The default is "Commands...".
  174. ;;;
  175. ;;; `recent-files-actions-on-top'
  176. ;;;    If this variable is non-nil, the "action" menu entries ("Make
  177. ;;;    <buffer> permanent" etc.) are put on top of the menu. Otherwise
  178. ;;;    they appear below the file entries or submenus. The default is
  179. ;;;    nil.
  180. ;;;
  181. ;;; `recent-files-permanent-first'
  182. ;;;    If this variable is t, the permanent entries are put first in
  183. ;;;    the recent-files menu, i.e. above the non-permanent entries. If
  184. ;;;    the value is nil, non-permanent entries appear first. If the
  185. ;;;    value is neither t nor nil, the entries are sorted according to
  186. ;;;    recent-files-sort-function. The default is 'sort.
  187. ;;;
  188. ;;; `recent-files-find-file-command'
  189. ;;;    This variable contains to commandto execute when a file entry
  190. ;;;    is selected from the menu. Usually this will be `find-file',
  191. ;;;    which is the default.
  192. ;;;
  193. ;;; KNOWN BUG:
  194. ;;;   - recent-files overwrites the recent-files-save-file
  195. ;;;     unconditionally when Emacs exits. If you have two Emacs
  196. ;;;     processes running, the one exiting later will overwrite the
  197. ;;;     file without merging in the new entries from the other Emacs
  198. ;;;     process. This can be avoided by disabling the save on exit from
  199. ;;;     the menu.
  200.  
  201. (if (not (string-match "XEmacs" (emacs-version)))
  202.     (error "recent-files works with Lucid Emacs / XEmacs only."))
  203.  
  204. (provide 'recent-files)
  205.  
  206.  
  207. ;;; User options
  208.  
  209. (defgroup recent-files nil
  210.   "Maintain a menu of recently opened files."
  211.   :group 'files
  212.   :group 'menu)
  213.  
  214. (defgroup recent-files-menu nil
  215.   "Menu options of recent-files."
  216.   :prefix "recent-files-"
  217.   :group 'recent-files)
  218.  
  219.  
  220. (defcustom recent-files-number-of-entries 15
  221.   "*Maximum of non-permanent entries in the recent-files menu."
  222.   :type 'integer
  223.   :group 'recent-files)
  224.  
  225. (defcustom recent-files-number-of-saved-entries 50
  226.   "*Maximum of non-permanent entries saved to `recent-files-save-file'."
  227.   :type 'integer
  228.   :group 'recent-files)
  229.  
  230. (defcustom recent-files-save-file (expand-file-name "~/.recent-files.el")
  231.   "*File to save the recent-files list in."
  232.   :type 'file
  233.   :group 'recent-files)
  234.  
  235. (defcustom recent-files-dont-include nil
  236.   "*List of regexps for filenames *not* to keep in recent-files."
  237.   :type '(repeat regexp)
  238.   :group 'recent-files)
  239.  
  240. (defcustom recent-files-use-full-names t
  241.   "*If non-nil, use the full pathname of a file in the recent-files menu.
  242. Otherwise use only the filename part. The `recent-files-filename-replacements'
  243. are not applied in the latter case."
  244.   :type 'boolean
  245.   :group 'recent-files)
  246.  
  247. (defcustom recent-files-filename-replacements
  248.   (list (cons (expand-file-name "~") "~"))
  249.   "*List of regexp/replacement pairs for filename filenamees.
  250. If a filename of a filename matches one of the regexps, it is replaced
  251. by the corresponding replacement."
  252.   :type '(repeat (cons regexp (string :tag "Replacement")))
  253.   :group 'recent-files)
  254.  
  255. (defcustom recent-files-sort-function (function recent-files-dont-sort)
  256.   "*Function to sort the recent-files list with.
  257. The value `recent-files-dont-sort' means to keep the \"most recent on top\"
  258. order."
  259.   :type 'function
  260.   :group 'recent-files)
  261.  
  262. (defcustom recent-files-permanent-submenu nil
  263.   "*If non-nil, put the permanent entries of recent-files into a submenu."
  264.   :type 'boolean
  265.   :group 'recent-files-menu)
  266.  
  267. (defcustom recent-files-non-permanent-submenu t
  268.   "*If non-nil, put the non-permanent entries of recent-files into a submenu."
  269.   :type 'boolean
  270.   :group 'recent-files-menu)
  271.  
  272. (defcustom recent-files-commands-submenu nil
  273.   "*If non-nil, put the commands of recent-files into a submenu."
  274.   :type 'boolean
  275.   :group 'recent-files-menu)
  276.  
  277. (defcustom recent-files-commands-submenu-title "Commands..."
  278.   "*Title of the commands submenu of recent-files."
  279.   :type 'string
  280.   :group 'recent-files-menu)
  281.  
  282. (defcustom recent-files-menu-title "Recent Files"
  283.   "*Name to be displayed as title of the recent-files menu."
  284.   :type 'string
  285.   :group 'recent-files-menu)
  286.  
  287. (defcustom recent-files-menu-path nil
  288.   "*Path where to add the recent-files menu.
  289. A value of nil means add it as top-level menu.
  290. For more information look up the documentation of `add-menu'."
  291.   :type '(choice (const :tag "Top Level" nil)
  292.          (sexp :tag "Menu Path"))
  293.   :group 'recent-files-menu)
  294.  
  295. (defcustom recent-files-add-menu-before nil
  296.   "*Name of the menu before which the recent-files menu shall be added.
  297. A value of nil means add it as the last menu in recent-files-menu-path.
  298. For more information look up the documentation of `add-menu'."
  299.   :type '(choice (string :tag "Name")
  300.          (const :tag "Last" nil))
  301.   :group 'recent-files-menu)
  302.  
  303. (defcustom recent-files-actions-on-top nil
  304.   "*If non-nil, put the actions on top of the recent-files menu."
  305.   :type 'boolean
  306.   :group 'recent-files-menu)
  307.  
  308. (defcustom recent-files-permanent-first 'sort
  309.   "*Control the placement of entries in the recent-files menu.
  310. If the value is t, permanent entries are put first.
  311. If the value is nil, non-permanent entries are put first.
  312. If the value is neither, the entries are mixed following
  313. recent-files-sort-function if neither appear in a submenu."
  314.   :type '(choice (const :tag "Permanent First" t)
  315.          (const :tag "Non-Permanent First" nil)
  316.          (sexp :tag "Mixed"))
  317.   :group 'recent-files-menu)
  318.  
  319. (defcustom recent-files-find-file-command (function find-file)
  320.   "*Command to invoke with an entry of the recent-files list."
  321.   :type 'function
  322.   :group 'recent-files)
  323.  
  324. (defcustom recent-files-include-save-now nil
  325.   "*If non-nil, have a menu entry to save the recent-files list immediately."
  326.   :type 'boolean
  327.   :group 'recent-files-menu)
  328.  
  329. ;;; Internal variables
  330.  
  331. (defconst recent-files-save-list-on-exit t
  332.   "If non-nil, save the recent-files list on exit.
  333. This value is toggled by a menu entry.")
  334.  
  335. (defvar recent-files-list nil
  336.   "List of recently opened files.
  337. Entries are pairs like (<filename> . <permant-p>).
  338. If <permanent-p> is non-nil, the file stays permanently in the list.")
  339.  
  340. (defvar recent-files-commands-menu
  341.   '(list (vector (concat "Make " lastpart " permanent")
  342.          (function recent-files-make-permanent)
  343.          (and lastpart
  344.               (not (recent-files-permanent-p filename))
  345.               ;; (not (not ...)) is needed to enforce t for non-nil
  346.               (not (not (recent-files-retrieve-entry filename)))))
  347.      (vector (concat "Make " lastpart " non-permanent")
  348.          (function recent-files-make-non-permanent)
  349.          (and lastpart
  350.               (recent-files-permanent-p filename)
  351.               (not (not (recent-files-retrieve-entry filename)))))
  352.      (vector "Erase non-permanent entries"
  353.          (function recent-files-erase-non-permanent)
  354.          t)
  355.      (vector (if recent-files-save-list-on-exit
  356.              "Don't save recent-files list on exit"
  357.            "Save recent-files list on exit")
  358.          ;; for some weird reason a (function (lambda ...))
  359.          ;; doesn't work here
  360.          (function recent-files-toggle-save-list-on-exit)
  361.          t)
  362.      (vector "Save recent-files list now"
  363.          (function recent-files-save-the-list)
  364.          t)
  365.      (vector (concat "Kill buffer " lastpart
  366.              " and delete entry")
  367.          (function recent-files-kill-buffer-delete-entry)
  368.          lastpart))
  369.   "Command menu definition for recent-files.
  370. This definition is evaluated in a context where `filename' holds the file
  371. name of the current buffer and `lastpart' holds the last component of
  372. `filename'.")
  373.  
  374.  
  375. (defconst recent-files-save-file-header
  376.   ";; This file is generated by recent-files.
  377. ;; The car of each entry of recent-files-save-list is to appear in the
  378. ;; `recent-files' menu. If the cdr of an entry is t, the file is to stay
  379. ;; in the menu permanently.
  380. ;; Saved at %s.
  381.  
  382. " "Header to be written into the `recent-files-save-file'.")
  383.  
  384.  
  385. (defconst recent-files-buffer-name " *recent files save list*"
  386.   "Name of the buffer to build the save file in.")
  387.  
  388. (defvar recent-files-list-changed-p t
  389.   "Non-nil if the recent-files-list has changed after last menubar update.")
  390.  
  391. (defvar recent-files-last-buffer nil
  392.   "Buffer at the time of last recent-files menu rebuild.
  393. If the buffer has changed, the menu must be rebuilt.")
  394.  
  395. ;;; Module initialization
  396.  
  397. (defun recent-files-initialize ()
  398.   "Initialize the recent-files menu."
  399.   (interactive)
  400.   (add-hook 'find-file-hooks (function recent-files-find-and-write-file-hook))
  401.   (add-hook 'dired-after-readin-hook
  402.         (function recent-files-find-and-write-file-hook))
  403.   (add-hook 'kill-emacs-hook (function recent-files-save-the-list))
  404.   (add-hook 'activate-menubar-hook (function recent-files-update-menu))
  405.   (add-hook 'write-file-hooks (function recent-files-find-and-write-file-hook))
  406.   ;; Initialize recent-files-list only if it is non-nil.
  407.   (cond (recent-files-list
  408.      (message "recent-files is already initialized."))
  409.     ((file-readable-p recent-files-save-file)
  410.      (setq recent-files-list-changed-p t)
  411.      (load-file recent-files-save-file)))
  412.   (recent-files-update-menu))
  413.  
  414.  
  415. (defun recent-files-version ()
  416.   "Return a string identifying the current verion of recent-files.
  417. If called interactively, show it in the echo area."
  418.   (interactive)
  419.   (let ((version "$Header: recent-files.el[1.9] Wed Jan 18 21:42:36 1995 nickel@prz.tu-berlin.de saved $"))
  420.     (if (interactive-p)
  421.     (message version)
  422.       version)))
  423.       
  424.  
  425. ;;; Hook functions
  426.  
  427. (defun recent-files-find-and-write-file-hook ()
  428.   "Find-file-hook, write-file-hook, and dired-mode-hook for recent-files.
  429. Inserts the name of the file just opened or written into the
  430. `recent-files-list' and updates the recent-files menu."
  431.   (recent-files-add-file (recent-files-get-file-name))
  432.   nil)
  433.  
  434.  
  435. (defun recent-files-get-file-name ()
  436.   "Return the filename of the current buffer or nil, if there is none.
  437. This functions is supposed to do \"the right thing\" also for some modes
  438. with no buffer-file-name. Currently supported: 'dired-mode."
  439.   (cond (buffer-file-name
  440.      buffer-file-name)
  441.     ((eq major-mode 'dired-mode)
  442.      (dired-current-directory))))
  443.  
  444.  
  445. (defun recent-files-save-the-list ()
  446.   "Save the current `recent-files-list' to the file `recent-files-save-file'.
  447. This is done by writing a `setq' statement to `recent-files-list' into
  448. the file."
  449.   (interactive)
  450.   (if recent-files-save-list-on-exit
  451.       (let ((l (recent-files-enforce-max-length
  452.         recent-files-number-of-saved-entries
  453.         recent-files-list)))
  454.     (save-excursion
  455.       (set-buffer (get-buffer-create recent-files-buffer-name))
  456.       (erase-buffer)
  457.       (insert (format recent-files-save-file-header (current-time-string)))
  458.       (insert "(setq recent-files-list \n      '(")
  459.       (if l
  460.           (progn
  461.         (while l
  462.           (if (bolp)
  463.               (insert "        "))
  464.           (prin1 (car l) (current-buffer))
  465.           (insert "\n")
  466.           (setq l (cdr l)))
  467.         (forward-line -1)))
  468.       (end-of-line)
  469.       (insert "))")
  470.       (if (file-writable-p recent-files-save-file)
  471.           (write-region (point-min) (point-max) recent-files-save-file))
  472.       (kill-buffer (current-buffer))))))
  473.  
  474.  
  475. ;;; Construct the menu
  476.  
  477. (defun recent-files-update-menu ()
  478.   "Update the recent-files menu from the recent-files-list."
  479.   (if (or recent-files-list-changed-p
  480.       (not recent-files-last-buffer)
  481.       (not (eq recent-files-last-buffer
  482.            (current-buffer))))
  483.       ;; This is an ugly mess...
  484.       (let ((action-menu-entries
  485.          (let ((entries
  486.             (let* ((filename (recent-files-get-file-name))
  487.                (lastpart (recent-files-last-part-of-name
  488.                       filename)))
  489.               (eval recent-files-commands-menu))))
  490.            (if recent-files-commands-submenu
  491.            (list (cons recent-files-commands-submenu-title
  492.                    entries))
  493.          entries)))           
  494.         permanent non-permanent all)
  495.     ;; ... getting weirder by the minute ...
  496.     (if (or recent-files-permanent-submenu
  497.         recent-files-non-permanent-submenu
  498.         (null recent-files-permanent-first)
  499.         (eq t recent-files-permanent-first))
  500.         (progn 
  501.           (setq permanent (recent-files-make-file-menu-entries
  502.                    recent-files-list
  503.                    (function recent-files-filter-permanent)))
  504.           (setq non-permanent (recent-files-make-file-menu-entries
  505.                    recent-files-list
  506.                    (function
  507.                     recent-files-filter-non-permanent))))
  508.       (setq all (recent-files-make-file-menu-entries
  509.              recent-files-list
  510.              (function (lambda (l) l)))))
  511.     (if recent-files-permanent-submenu
  512.         (setq permanent (list (cons "Permanent entries..." permanent))))
  513.     (if recent-files-non-permanent-submenu
  514.         (setq non-permanent (list (cons "Non-permanent entries..."
  515.                         non-permanent))))
  516.     ;;; ... and now even uglier.
  517.     (add-menu recent-files-menu-path recent-files-menu-title
  518.           (nconc
  519.            (if recent-files-actions-on-top
  520.                (append action-menu-entries (list "-----")))
  521.            (if (or recent-files-permanent-submenu
  522.                recent-files-non-permanent-submenu)
  523.                (if recent-files-permanent-first
  524.                (nconc permanent non-permanent)
  525.              (nconc non-permanent permanent))
  526.              (cond ((eq t recent-files-permanent-first)
  527.                 (nconc permanent non-permanent))
  528.                ((null recent-files-permanent-first)
  529.                 (nconc non-permanent permanent))
  530.                (t all)))
  531.            (if (not recent-files-actions-on-top)
  532.                (cons "-----"
  533.                  action-menu-entries)))
  534.           recent-files-add-menu-before)
  535.     (setq recent-files-list-changed-p nil)
  536.     (setq recent-files-last-buffer (current-buffer))))
  537.   nil)
  538.  
  539.  
  540. (defun recent-files-retrieve-entry (filename)
  541.   "Retrieve an entry from the recent-files list."
  542.   (assoc filename recent-files-list))
  543.  
  544.  
  545. (defun recent-files-make-file-menu-entries (recent-list filter)
  546.   "Make file menu entries for recent-files from RECENT-LIST using FILTER."
  547.   (mapcar (function recent-files-entry-to-menu-entry)
  548.       (funcall filter
  549.            (funcall recent-files-sort-function
  550.                   (recent-files-enforce-max-length
  551.                    recent-files-number-of-entries
  552.                    recent-list)))))
  553.  
  554.  
  555. (defun recent-files-last-part-of-name (filename)
  556.   "Return last part of FILENAME."
  557.   (if filename
  558.       (if (and (file-directory-p filename)
  559.            (equal (substring filename -1) "/"))
  560.       (concat (file-name-nondirectory
  561.            (substring filename 0 -1))
  562.           "/")
  563.     (file-name-nondirectory filename))))
  564.  
  565.  
  566. (defun recent-files-filter-permanent (recent-list)
  567.   "Return list of permanent entries in RECENT-LIST."
  568.   (cond ((null recent-list) nil)
  569.     ((recent-files-permanent-p (car (car recent-list)))
  570.      (cons (car recent-list)
  571.            (recent-files-filter-permanent (cdr recent-list))))
  572.     (t (recent-files-filter-permanent (cdr recent-list)))))
  573.  
  574.  
  575. (defun recent-files-filter-non-permanent (recent-list)
  576.   "Return list of non-permanent entries in RECENT-LIST."
  577.   (cond ((null recent-list) nil)
  578.     ((recent-files-permanent-p (car (car recent-list)))
  579.      (recent-files-filter-non-permanent (cdr recent-list)))
  580.     (t (cons (car recent-list)
  581.          (recent-files-filter-non-permanent (cdr recent-list))))))
  582.  
  583.  
  584. (defun recent-files-permanent-p (filename)
  585.   "Return non-nil if FILENAME is a permanent entry in the recent-files menu."
  586.   (cdr (recent-files-retrieve-entry filename)))
  587.  
  588.  
  589. (defun recent-files-entry-to-menu-entry (entry)
  590.   "Build a menu entry from an entry in `recent-files-list'."
  591.   (vector (concat (if (cdr entry)
  592.               "* "
  593.             "  ")
  594.           (if recent-files-use-full-names
  595.               (recent-files-replace-filenames (car entry))
  596.             (recent-files-last-part-of-name (car entry))))
  597.       (list recent-files-find-file-command (car entry))
  598.       t))
  599.  
  600.  
  601. (defun recent-files-replace-filenames (filename)
  602.   "Replace the part of FILENAME that matches a regular expression
  603. in recent-files-filename-replacements with the corrensponding replacement.
  604. If FILENAME does not match any regular expression, return it unchanged.
  605. Only the first matching regexp/replacement pair is applied."
  606.   (let ((replist recent-files-filename-replacements)
  607.     (retval filename)
  608.     (matched nil))
  609.     (while (and replist
  610.         (not matched))
  611.       (if (string-match (car (car replist)) filename)
  612.       (progn
  613.         (setq matched t)
  614.         (setq retval (concat (substring filename 0 (match-beginning 0))
  615.                  (cdr (car replist))
  616.                  (substring filename (match-end 0))))))
  617.       (setq replist (cdr replist)))
  618.     retval))
  619.  
  620.  
  621. ;;; add a new entry
  622.  
  623. (defun recent-files-add-file (filename)
  624.   "Add file FILENAME to `recent-files-list'.
  625. FILENAME is not really added if it matches one of the regexps in
  626. `recent-files-dont-include'."
  627.   (if (recent-files-no-match filename recent-files-dont-include)
  628.       (progn
  629.     (setq recent-files-list-changed-p t)
  630.     (setq recent-files-list
  631.           (cons (or (recent-files-retrieve-entry filename)
  632.             (cons filename nil))
  633.             (recent-files-remove-entry filename
  634.                            recent-files-list))))))
  635.  
  636.  
  637. (defun recent-files-dont-sort (recent-list)
  638.   "Return RECENT-LIST.
  639. This is a dummy sorting function for the recent-files-list."
  640.   recent-list)
  641.  
  642. (defun recent-files-sort-alphabetically (recent-list)
  643.   "Return RECENT-LIST sorted alphabetically by the cars of the elements."
  644.   (sort recent-list (function
  645.              (lambda (e1 e2)
  646.                (string-lessp (car e1) (car e2))))))
  647.  
  648.  
  649. (defun recent-files-enforce-max-length (n l)
  650.   "Return a list of all permanent and the first N non-permanent entries of L.
  651. Preserve the order of the entries."
  652.   (let ((count 0)
  653.     (newlist nil))
  654.     (while l
  655.       (if (cdr (car l))
  656.       (setq newlist (cons (car l) newlist))
  657.     (if (< count n)
  658.         (setq newlist (cons (car l) newlist)))
  659.     (setq count (1+ count)))
  660.       (setq l (cdr l)))
  661.     (nreverse newlist)))
  662.  
  663.  
  664. (defun recent-files-remove-entry (fname recent-list)
  665.   "Delete all elements that have FNAME as a car from RECENT-LIST.
  666. The constructed list returned, RECENT-LIST is not changed.
  667. Comparison is done with equal."
  668.   (let ((newlist nil))
  669.     (while recent-list
  670.       (if (not (equal (car (car recent-list)) fname))
  671.       (setq newlist (cons (car recent-list) newlist)))
  672.       (setq recent-list (cdr recent-list)))
  673.     (nreverse newlist)))
  674.  
  675. (defun recent-files-no-match (string re-list)
  676.   "Return t if STRING matches none of the regexps in RE-LIST."
  677.   (while (and re-list
  678.           (not (string-match (car re-list) string)))
  679.     (setq re-list (cdr re-list)))
  680.   (null re-list))
  681.  
  682.  
  683. ;;; Menu commands
  684.  
  685. (defun recent-files-make-permanent ()
  686.   "Make the file in current buffer a permanent entry in recent-files."
  687.   (interactive)
  688.   (rplacd (recent-files-retrieve-entry (recent-files-get-file-name)) t)
  689.   (setq recent-files-list-changed-p t))
  690.  
  691.  
  692. (defun recent-files-make-non-permanent ()
  693.   "Make the file in current buffer a non-permanent entry in recent-files."
  694.   (interactive)
  695.   (rplacd (recent-files-retrieve-entry (recent-files-get-file-name)) nil)
  696.   (setq recent-files-list-changed-p t))
  697.  
  698.  
  699. (defun recent-files-kill-buffer-delete-entry ()
  700.   "Kill the current buffer and delete its entry in the recent-files menu."
  701.   (interactive)
  702.   (setq recent-files-list
  703.     (recent-files-remove-entry (recent-files-get-file-name)
  704.                    recent-files-list))
  705.   (setq recent-files-list-changed-p t)
  706.   (kill-buffer (current-buffer)))
  707.  
  708. (defun recent-files-erase-non-permanent ()
  709.   "Erase all non-permanent entries from the recent-files menu."
  710.   (interactive)
  711.   (setq recent-files-list
  712.     (recent-files-filter-permanent recent-files-list))
  713.   (setq recent-files-list-changed-p t))
  714.  
  715. (defun recent-files-toggle-save-list-on-exit ()
  716.   "Toggle the value of `recent-files-save-list-on-exit'."
  717.   (interactive)
  718.   (setq recent-files-save-list-on-exit (not recent-files-save-list-on-exit))
  719.   (setq recent-files-list-changed-p t))
  720.  
  721. ;;; EOF
  722.